{-Error-}
module Data.Binary.Get where
import Prelude

import Control.Monad.Error.Class (throwError)
import Data.Binary.Get.Internal as I
import Data.ByteString as B
import Data.Either (Either(..))
import Data.Integral (fromIntegral)
import Data.Integral as BI
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\),Tuple3)
import Data.UInt as U
import Data.Word (Word16(..), Word8(..))
import Effect.Console (error)
import Type.Quotient (runQuotient)
import Unsafe.Coerce (unsafeCoerce)

data Decoder a = Fail B.ByteString ByteOffset String
               | Partial (Maybe B.ByteString -> Decoder a)
               | Done B.ByteString ByteOffset a


type ByteOffset = Int


otoW8::B.Octet -> Word8
otoW8 o = fromIntegral $ runQuotient o

getWord8 :: I.Get Word8
getWord8 = do
  mr <- I.readN 1 B.head
  case mr of
   Nothing   -> throwError "getWord8 Error"
   Just    r -> pure $ (fromIntegral $ runQuotient  r)
   

getInt8 :: I.Get Int
getInt8 = fromIntegral <$> getWord8

getWord16be :: I.Get Word16
getWord16be = I.readN 2 word16be

word16be :: B.ByteString -> Word16
word16be bs = Word16 $ (U.shl a  (U.fromInt 8))  `U.or`  b 
   where
   (Word8 a)  = otoW8 $ B.unsafeIndex bs 0
   (Word8 b)  = otoW8 $ B.unsafeIndex bs 1


runGetOrFail ::forall a. I.Get a -> B.ByteString -> Either (Tuple3 B.ByteString ByteOffset String) (Tuple3 B.ByteString  ByteOffset  a)
runGetOrFail g lbs0 = feedAll (runGetIncremental g) lbs0
  where
  feedAll (Done bs pos x) lbs = Right (B.empty /\ pos /\ x /\ unit)
  feedAll (Partial k) lbs = feedAll (k (takeHeadChunk lbs)) (dropHeadChunk lbs)
  feedAll (Fail x pos msg) xs = Left (B.empty /\ pos /\ msg /\ unit)

runGet ::forall a. I.Get a -> B.ByteString -> a
runGet g lbs0 = feedAll (runGetIncremental g) lbs0
  where
  feedAll (Done _ _ x) _ = x
  feedAll (Partial k) lbs = feedAll (k (takeHeadChunk lbs)) (dropHeadChunk lbs)
  feedAll (Fail _ pos msg) _ = unsafeCoerce $ error $ ("Data.Binary.Get.runGet at position " <> show pos <> ": " <> msg)

takeHeadChunk :: B.ByteString -> Maybe B.ByteString
takeHeadChunk lbs = Just lbs

dropHeadChunk :: B.ByteString -> B.ByteString
dropHeadChunk lbs = B.empty

runGetIncremental ::forall a. I.Get a -> Decoder a
runGetIncremental = calculateOffset <<< I.runGetIncremental

calculateOffset ::forall a. I.Decoder a -> Decoder a
calculateOffset r0 =  go r0 0
  where
    go r acc = case r of
                 I.Done inp a -> Done inp (acc - fromIntegral (B.length inp)) a
                 I.Fail inp s -> Fail inp (acc - fromIntegral (B.length inp)) s
                 I.Partial k ->
                    Partial $ \ms ->
                      case ms of
                        Nothing -> go (k Nothing) acc
                        Just i ->  go (k ms) (acc + fromIntegral (B.length i))
                 I.BytesRead unused k -> do
                  go (k $ ((BI.toBigInt acc) -  unused)) acc